CU Amiga Super CD-ROM 27/CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso/CUCD/Programming/rxlistview/testrxlv.rexx

OS/2 REXX Batch file | 1998-08-15 | 10.7 KB | 347 lines

/*
** $VER: testrxlv.rexx 1.3 (15.8.98) Rolf Rotvel
*/

/*
** The listview uses functions from rexxsupport.library...
*/
call addlib('rexxsupport.library', 0, -30, 0)

/*
** First set the variables that decide how big the listview should be.
** This must be done before rxlv_init() is called.
*/
rxlv.width = 300
rxlv.height = 200

/*
** Initialize the listview. This needs to be done only once.
*/
call rxlv_init()

/*
** Create a test stem. The stem must have the following format:
**
** <stemname>.0 = number of elements
** <stemname>.1 = element no 1
** <stemname>.2 = element no 2
** ...
*/
do i = 1 to 20
    teststem.i = copies(i, i)
end
teststem.0 = 20

/*
** Now create the formatted stem, "viewline.", for the listview.
** rxlv_init() must have been called before this to create the
** rxlv.dispcols value.
** "viewline." is the only global variable besides "rxlv." that the
** listview procedures shares with the rest of the script.
*/
do i = 1 to teststem.0
    viewline.i = left(teststem.i, rxlv.dispcols)
end
viewline.0 = teststem.0

/*
** Loop while displaying the listview.
**
** The syntax for the main listview procedure is:
** num = rxlv_main(<title text>, <inline keys>)
**
** <title text> will be displayed in the window title.
** <inline keys> will be checked in addition to the normal keys. Which are
** (Shift)Cursor up/down, Return, Delete, Escape and Help.
**
** <num> is the variable number of the highlighted item in the listview or
** 0 if the list is empty. <num> is always returned no matter what key the
** user presses to leave the listview.
**
** The variable rxlv.key contains either the exact inline key or one of the
** following:
** RET : User pressed Return
** DEL :              Delete
** ESC :              Escape
**
** Note that the inline keys are case sensitive. Also note that you have to
** decide for yourself what to do when the user presses Return, Delete or
** Escape (And Help)
*/
do forever
     num = rxlv_main('"q" or "ESC" quits ['viewline.0'] "HELP" for keys', 'qQ')
     say 'You pressed  : 'rxlv.key
     say 'And selected : 'teststem.num

     select
        when upper(rxlv.key) = 'Q' | rxlv.key = 'ESC' then leave
        when rxlv.key = 'DEL' then do
            if teststem.0 > 0 then do
                do i = num to teststem.0
                    next = i + 1
                    teststem.i = textstem.next
                    viewline.i = viewline.next
                end
                teststem.0 = teststem.0 - 1
                viewline.0 = teststem.0
            end
        end
        otherwise nop
    end
end
exit


/*
** In this procedure you decide what will happen when the user presses Help
** in the listview. If you don't want anything to happen then just let it
** return immediately.
*/
RXLV_HELP: procedure
say 'Use Cursor/Shift Cursor to'
say 'move and Enter to select.'
say 'Help gives you this text :-)'
say 'Delete deletes an item in the list'
say 'Escape or q exits the listview'
return

/*
** Don't touch anything after the rxlv_help() procedures. Unless you know
** what you're doing of course :-)
*/
RXLV_MAIN: procedure expose viewline. rxlv.
parse arg titletxt, inlinechars

/* Reset key */
rxlv.key = ''

/* Which is bigger - win rows or lines in stemvar? */
if rxlv.disprows > viewline.0 then rxlv.actrows = viewline.0
else rxlv.actrows = rxlv.disprows

/* Get current mouse coordinates */
call forbid
screen = next(rxlv.intui, 56)                         /* IntuitionBase->ActiveScreen */
mousex = c2d(import(offset(screen, 18), 2)) - 50      /* Screen->MouseX */
mousey = c2d(import(offset(screen, 16), 2)) - 50      /* Screen->MouseY */
call permit

/* Open the listview */
call open(rxlv.win, 'RAW:'mousex'/'mousey'/'rxlv.width'/'rxlv.height'/'titletxt'/NOSIZE', 'w')
call writech(rxlv.win, rxlv.nocursor||rxlv.nowordwrap)

/* Initialize window */
if viewline.0 > 0 then do
    rxlv.row = 1
    rxlv.var = 1
    rxlv.topvar = 1
    call writech(rxlv.win, rxlv_getlighty(rxlv.row, rxlv.var)||rxlv.nl||rxlv_getpage(rxlv.var + 1))
end

/* Do ze stuff */
do forever
    rxlv.oldrow = rxlv.row
    rxlv.oldvar = rxlv.var

    char = readch(rxlv.win, 1)
    select
        when char = rxlv.csi then do
            char = readch(rxlv.win, 1)
            select
                when viewline.0 < 2 then nop
                when char = rxlv.cursordown then do
                    if rxlv.oldvar ~= viewline.0 then do
                        line = rxlv_getunlighty()
                        rxlv.var = rxlv.var + 1

                        if rxlv.oldrow < rxlv.actrows then rxlv.row = rxlv.row + 1
                        else do
                            line = line||rxlv.nl
                            rxlv.row = rxlv.actrows
                            rxlv.topvar = rxlv.topvar + 1
                        end
                        call writech(rxlv.win, line||rxlv_getlighty())
                    end
                    else call rxlv_top()
                end
                when char = rxlv.cursorup then do
                    if rxlv.oldvar ~= 1 then do
                        line = rxlv_getunlighty()
                        rxlv.var = rxlv.var - 1

                        if rxlv.oldrow ~= 1 then do
                            rxlv.row = rxlv.row - 1
                            call writech(rxlv.win, line||rxlv_getlighty())
                        end
                        else do
                            rxlv.row = 1
                            rxlv.topvar = rxlv.topvar - 1
                            call writech(rxlv.win, line||rxlv_getlighty()||rxlv.nl||rxlv_getpage(rxlv.var + 1))
                        end
                    end
                    else call rxlv_bottom()
                end
                when char = rxlv.scursorup then do
                    if rxlv.oldvar ~= 1 then do
                        rxlv.row = 1
                        rxlv.var = rxlv.topvar

                        if rxlv.oldrow = 1 then do
                            if rxlv.oldvar - rxlv.actrows < 1 then rxlv.topvar = 1
                            else rxlv.topvar = rxlv.oldvar - rxlv.actrows
                            rxlv.var = rxlv.topvar
                            call writech(rxlv.win, rxlv.cls||rxlv_getlighty()||rxlv.nl||rxlv_getpage(rxlv.topvar + 1))
                        end
                        else call writech(rxlv.win, rxlv_getunlighty()||rxlv_getlighty())
                    end
                    else call rxlv_bottom()
                end
                when char = rxlv.scursordown then do
                    if rxlv.oldvar ~= viewline.0 then do
                        rxlv.row = rxlv.actrows

                        if rxlv.oldrow = rxlv.actrows then do
                            if rxlv.oldvar + rxlv.actrows > viewline.0 then rxlv.topvar = viewline.0 - (rxlv.actrows - 1)
                            else rxlv.topvar = rxlv.oldvar + 1
                            rxlv.var = min(viewline.0, rxlv.topvar + (rxlv.actrows - 1))
                            call writech(rxlv.win, rxlv.cls||rxlv_getpage(rxlv.topvar)||rxlv.nl||rxlv_getlighty())
                        end
                        else do
                            rxlv.var = (rxlv.topvar + rxlv.actrows) - 1
                            call writech(rxlv.win, rxlv_getunlighty()||rxlv_getlighty())
                        end
                    end
                    else call rxlv_top()
                end
                otherwise nop
            end
        end
        when char = rxlv.esc then do
            rxlv.key = 'ESC'
            return rxlv_close()
        end
        when char = rxlv.cr then do
            rxlv.key = 'RET'
            return rxlv_close()
        end
        when char = rxlv.del then do
            rxlv.key = 'DEL'
            return rxlv_close()
        end
        when pos(char, inlinechars) > 0 then do
            rxlv.key = char
            return rxlv_close()
        end
        when char = rxlv.help then call rxlv_help()
        otherwise nop
    end
end


RXLV_CLOSE: procedure expose rxlv. viewline.
call close(rxlv.win)
if viewline.0 = 0 then return 0
return rxlv.oldvar


RXLV_TOP: procedure expose rxlv. viewline.
rxlv.var = 1
rxlv.row = 1

if rxlv.topvar = 1 then do   /* Just move to top */
    line = rxlv_getunlighty()
    call writech(rxlv.win, line||rxlv_getlighty())
end
else do
    rxlv.topvar = 1
    call writech(rxlv.win, rxlv.cls||rxlv_getlighty()||rxlv.nl||rxlv_getpage(rxlv.var + 1))
end
return


RXLV_BOTTOM: procedure expose rxlv. viewline.
rxlv.var = viewline.0

if viewline.0 <= rxlv.actrows then do
    line = rxlv_getunlighty()
    rxlv.row = viewline.0
    call writech(rxlv.win, line||rxlv_getlighty())
end
else do
    rxlv.row = rxlv.actrows
    rxlv.topvar = (viewline.0 - rxlv.actrows) + 1
    call writech(rxlv.win, rxlv.cls||rxlv_getpage(rxlv.topvar)||rxlv.nl||rxlv_getlighty())
end
return


RXLV_GETPAGE: procedure expose viewline. rxlv.
if viewline.0 = 1 then return ''

top = arg(1)
page = ''
do y = 1 to rxlv.actrows - 2                    /* Lines between first and last */
    page = page||viewline.top||rxlv.nl
    top = top + 1
end
page = page||viewline.top                       /* No newline after last line */
return page


RXLV_GETUNLIGHTY: procedure expose rxlv. viewline.
var = rxlv.oldvar
return rxlv.csi||rxlv.oldrow'H'viewline.var


RXLV_GETLIGHTY: procedure expose rxlv. viewline.
var = rxlv.var
return rxlv.csi||rxlv.row'H'rxlv.hilite||viewline.var||rxlv.off


RXLV_INIT: procedure expose rxlv.
/* Hardcoded minimum values */
rxlv.width = max(100, rxlv.width)
rxlv.height = max(50, rxlv.height)

/* ANSI stuff */
rxlv.csi = '9b'x  ; rxlv.esc = '1b'x
rxlv.help = '7e'x ; rxlv.del = '7f'x
rxlv.nl = '0a'x   ; rxlv.cr = '0d'x
rxlv.off = rxlv.csi||'0m'
rxlv.topleft = rxlv.csi'48'x
rxlv.cls = rxlv.csi'H'rxlv.csi'J'
rxlv.hilite = rxlv.csi'43;32m'
rxlv.nowordwrap = rxlv.csi||'3f376c'x
rxlv.nocursor = rxlv.csi||'302070'x
rxlv.cursorup = '41'x  ; rxlv.cursordown = '42'x
rxlv.scursorup = '54'x ; rxlv.scursordown = '53'x
rxlv.win = 'listwin'

/* GUI constants */
guiheight = 7 ; guiwidth = 8

/* Font info */
rxlv.intui = showlist(l, 'intuition.library',, a)
call forbid
screen = next(rxlv.intui, 56)               /* IntuitionBase->ActiveScreen */
font = next(screen, 136)                    /* Screen->RastPort.Font */
fonty = c2d(import(offset(font, 20), 2))    /* Font->YSize */
fontx = c2d(import(offset(font, 24), 2))    /* Font->XSize */
call permit

/* Listview width */
do while (rxlv.width - guiwidth) // fontx ~= 0
    rxlv.width = rxlv.width + 1
end
rxlv.dispcols = ((rxlv.width - guiwidth) % fontx)
rxlv.filler = copies(' ', rxlv.dispcols)

/* Listview height */
const = guiheight + fonty
do while (rxlv.height - const) // fonty ~= 0
    rxlv.height = rxlv.height + 1
end
rxlv.disprows = (rxlv.height - const) % fonty

return